home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / structs.h < prev    next >
C/C++ Source or Header  |  1992-10-27  |  15KB  |  603 lines
  1. /* ******************************************************************** */
  2. /*  structs.h        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Basic definitions of tags and structures                             */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, April 1989
  10.  *   added a little support for classes RJB
  11.  *   hacked it about a bit KJP
  12.  *   added semaphores KJP
  13.  */
  14.  
  15. #ifndef STRUCTS_H
  16. #define STRUCTS_H
  17.  
  18. #include <stdio.h>
  19.  
  20. #ifdef WITH_BIGNUMS
  21. #include "BigZ.h"
  22. #endif
  23. #undef BIGNUM
  24.  
  25. #ifndef SETJMP_H
  26. #define SETJMP_H
  27. #include <setjmp.h>
  28. #endif
  29.  
  30. /* Load system types... */
  31.  
  32. #include "system_t.h"
  33.  
  34. /*#include "compact.h"*/
  35. /* Primitive types... */
  36.  
  37. /* indiacte that ob can be swept */
  38. /* note that the bignum typeof operation may need to be changed 
  39.    plus some comparisons in arith.c --- unless we do them right
  40.    --- pab */
  41.  
  42. #define CALLABLE_TYPE 0x100
  43. #define MACRO_TYPE    0x200
  44. #define STATIC_TYPE   0x400
  45.  
  46. #define TYPE_UNUSED     -1
  47.  
  48. #define TYPE_ENV    0xe0
  49.  
  50. #define TYPE_CONS    0x1
  51. #define TYPE_CHAR    (0x2)
  52. #define TYPE_STRING    (0x3)
  53. #define TYPE_TABLE    (0x5)
  54. #define TYPE_SYMBOL     (0x6)
  55. #define TYPE_THREAD    (0xb)
  56. #define TYPE_STREAM    (0xc)
  57. #define TYPE_CLASS    (0xd)
  58. #define TYPE_INSTANCE    (0xe)
  59. #define TYPE_SPECIAL    (0xf)
  60. #define TYPE_VECTOR    0x10
  61.  
  62. #define TYPE_INT    (0x11)
  63. #define TYPE_RATIONAL    (0x14)
  64. #define TYPE_FLOAT    (0x15)
  65. #define TYPE_COMPLEX    (0x16)
  66. #define TYPE_BIGNUM     (0x17)
  67. #define TYPE_LASTNUMBER 0x2f
  68.  
  69. #define TYPE_CONTINUE    (0x30)
  70.  
  71. #define TYPE_C_MODULE   (0x40)
  72. #define TYPE_I_MODULE   (0x50)
  73. #define TYPE_C_FUNCTION (0x60 | 0x100)
  74. #define TYPE_I_FUNCTION (0x61 | 0x100)
  75. #define TYPE_METHOD     0x62
  76. #define TYPE_GENERIC    (0x63 | 0x100)
  77.  
  78. #define TYPE_C_MACRO    (0x70 | 0x200)
  79. #define TYPE_I_MACRO    (0x71 | 0x200)
  80.  
  81. #define TYPE_SEMAPHORE  (0x90)
  82. #define TYPE_LISTENER   (0xa0)
  83. #define TYPE_SOCKET     (0xa1)
  84. #define TYPE_NULL       (0xb0)
  85. #define TYPE_WEAK_WRAPPER 0xc0
  86.  
  87. #define TYPE_B_FUNCTION (0x7a | 0x100)
  88. #define TYPE_B_MACRO    (0x7b | 0x200)
  89. /* Primitive accessors... */
  90. #ifdef NOLOWTAGINTS
  91. #define typeof(p)      ((p)->OBJECT.header.type)
  92. #define classof(p)      ((p)->OBJECT.header.class)
  93. #else
  94. #define typeof(p)       (((int)p) & 1 ? TYPE_INT: ((p)->OBJECT.header.type))
  95. #define classof(p)     (((int)p) & 1 ? Integer: ((p)->OBJECT.header.class))
  96. #endif
  97. #define type_of(p)      typeof(p)
  98. #define gcof(p)         (((p)->OBJECT).header.gc)
  99. #define gc_of(p)        gcof(p)
  100. #define lval_classof(p)  ((p)->OBJECT.header.class)
  101. #define lval_typeof(p)   ((p)->OBJECT.header.type)
  102.  
  103. #define class_of(p)     classof(p)
  104.  
  105. /* Primitive type testers... */
  106.  
  107. #define is_cons(p)      (typeof(p) == TYPE_CONS)
  108. #define is_char(p)      (typeof(p) == TYPE_CHAR)
  109. #define is_string(p)    (typeof(p) == TYPE_STRING)
  110. #define is_table(p)     (typeof(p) == TYPE_TABLE)
  111. #define is_symbol(p)    (typeof(p) == TYPE_SYMBOL)
  112. #define is_function(p)  (typeof(p) & CALLABLE_TYPE)
  113. #define is_macro(p)     (typeof(p) & MACRO_TYPE)
  114. #define is_static(p)    (typeof(p) & STATIC_TYPE)
  115. #define is_module(p)    ((typeof(p) == TYPE_I_MODULE)  | \
  116.              (typeof(p) == TYPE_C_MODULE))
  117. #define is_special(p)   (typeof(p) == TYPE_SPECIAL)
  118. #define is_thread(p)    (typeof(p) == TYPE_THREAD)
  119. #define is_stream(p)    (typeof(p) == TYPE_STREAM)
  120. #ifdef NOLOWTAGINTS
  121. #define is_fixnum(p)    (typeof(p) == TYPE_INT)
  122. #else
  123. #define is_fixnum(p)    (((int) (p)) &1)
  124. #define mk_fixnum(x)     ((LispObject) (((x)<<1) | 1))
  125. #endif
  126.  
  127. #define is_bignum(p)    (typeof(p) == TYPE_BIGNUM)
  128. #define is_float(p)     (typeof(p) == TYPE_FLOAT)
  129. #define is_vector(p)    ((typeof(p)&TYPE_VECTOR) == TYPE_VECTOR)
  130. #define is_continue(p)    (typeof(p) == TYPE_CONTINUE)
  131.  
  132.  
  133.  
  134. #define is_c_function(p) (typeof(p) == TYPE_C_FUNCTION)
  135. #define is_c_module(p)  (typeof(p) == TYPE_C_MODULE)
  136. #define is_i_function(p) (typeof(p) == TYPE_I_FUNCTION)
  137. #define is_i_module(p)  (typeof(p) == TYPE_I_MODULE)
  138. #define is_c_macro(p)   (typeof(p) == TYPE_C_MACRO)
  139. #define is_i_macro(p)   (typeof(p) == TYPE_I_MACRO)
  140. #define is_b_function(p) (typeof(p)==TYPE_B_FUNCTION)
  141. #define is_b_macro(p)    (typeof(p) == TYPE_B_MACRO)
  142.  
  143. #define is_semaphore(p) (typeof(p) == TYPE_SEMAPHORE)
  144. #define is_listener(p)  (typeof(p) == TYPE_LISTENER)
  145. #define is_socket(p)    (typeof(p) == TYPE_SOCKET)
  146. #define is_weak_wrapper(p) (typeof(p) == TYPE_WEAK_WRAPPER)
  147.  
  148. #define is_e_function(p) (0)
  149. #define is_e_macro(p) (0)
  150.  
  151. /* Other macros... */
  152.  
  153. #define null(p)      ((LispObject)(p) == nil)
  154. #define consp(p)     (is_cons(p) && (p) != nil)
  155. #define symbolp(p)   (is_symbol(p) || (p) == nil)
  156. #define CAR(p)         (((p)->CONS).car)
  157. #define CDR(p)         (((p)->CONS).cdr)
  158. #define classp(p)    (typeof(p) & 0x2000)
  159. #define is_number(p) (typeof(p) >= TYPE_INT && typeof(p) <= TYPE_LASTNUMBER)
  160.  
  161. typedef union lispunion *LispObject;
  162.  
  163. /* GC used object... */
  164.  
  165. struct hunk_structure {
  166.   short        type;
  167.   short        gc;
  168.   LispObject   next_hunk;
  169.   int          hunk_size;
  170. };
  171.  
  172. typedef struct Object_struct
  173. {
  174.   short type;
  175.   short gc;
  176.   LispObject class;
  177. } Object_t;
  178.  
  179. struct envobject {
  180.   Object_t        header;
  181.   LispObject        variable;
  182.   LispObject        value;
  183.   struct envobject *    next;
  184.   LispObject        mutable;
  185. };
  186.  
  187. typedef struct envobject *Env;
  188.  
  189. /* the top most class object */
  190.  
  191. struct object_structure {
  192.   Object_t    header;
  193.   LispObject    slots[1];    /* the other slots */
  194. };
  195.  
  196.  
  197. struct integer_structure {
  198.   Object_t     header;
  199.   int        value_part;
  200. };
  201. #ifdef NOLOWTAGINTS
  202. #define intval(x) ((x)->INT.value_part)
  203. #else
  204. #define intval(x) (((int)x)>>1)
  205. #endif
  206.  
  207. /* low tag ints */
  208.  
  209.  
  210.  
  211. struct float_structure {
  212.   Object_t     header;
  213.   double    fvalue;
  214. };
  215.  
  216. struct bignum_structure {
  217. Object_t header;
  218. #ifdef WITH_BIGNUMS
  219.   BigZ          value;
  220. #endif
  221.  
  222.   int *         bnum;
  223. };
  224.  
  225. struct complex_structure {
  226.   Object_t header;
  227.   LispObject    real;
  228.   LispObject    imaginary;
  229. };
  230.  
  231. struct ratio_structure {
  232.   Object_t header;
  233.   LispObject    numerator;
  234.   LispObject    denominator;
  235. };
  236.  
  237. struct character_structure {
  238.   Object_t header; 
  239.   unsigned char    font;
  240.   unsigned char    code;
  241. };
  242.  
  243. struct symbol_structure {
  244.   Object_t    header;
  245.   int         hash;      /* hash value cache */
  246.   LispObject    lhash;      /* as a lispobject */
  247.   LispObject    lmodule;  /* Module lookup cache for the interpreter */
  248.   LispObject    lvalue;   /* Part II */
  249.   LispObject    gvalue;   /* Dynamic global value */
  250.   LispObject    plist;
  251.   LispObject    pname;
  252.  
  253.   LispObject left;
  254.   LispObject right;
  255. };
  256.  
  257. /* comparator is a equality function, defaulting to Fn_equal,
  258.  * returning t or nil.
  259.  */
  260.  
  261. struct table_structure {
  262.   Object_t header; 
  263.   LispObject    (*comparator)(LispObject*);
  264.   LispObject    lisp_comparator;
  265.   LispObject    tree;
  266. };
  267.  
  268. /* This one is an internal type, used by tables and arrays.
  269.  * "base" is the first element in the array -- the others follow
  270.  * on directly --- note that this comment is carp (anag)
  271.  */
  272.  
  273.  
  274. #ifdef notdef /* Thu Oct 17 14:49:31 1991 */
  275. /**/
  276. /**/#define vref(v,n)  (*((v)->VECTOR.base + (n)))
  277. /**/#define vrefupdate(v,n,obj) (vref(v,n)=obj)
  278. #endif /* notdef Thu Oct 17 14:49:31 1991 */
  279.  
  280. #define vref(v,n) (*(&((v)->VECTOR.base) + (n)))
  281. #define vrefupdate(v,n,obj) (vref(v,n)=(obj))
  282. struct vector_structure {
  283.   Object_t header;
  284.   int length;            /* for now */
  285.   LispObject base;           
  286. };
  287.  
  288. #ifdef WITH_SMALL_CONSES
  289. struct cons_structure {
  290.   short        type;
  291.   short        gc;
  292.   LispObject    car;
  293.   LispObject    cdr;
  294. };
  295. #else
  296. struct cons_structure {
  297.   Object_t header;
  298.   LispObject    car;
  299.   LispObject    cdr;
  300. };
  301. #endif
  302.  
  303.  
  304. struct stream_structure {
  305.   Object_t header;
  306.   FILE*        handle;
  307.   LispObject    name;
  308.   int        curchar;
  309.   int        mode;
  310. };
  311.  
  312. struct string_structure {
  313.   Object_t header;
  314.   int length;
  315.   char value; /* really a c-string --- Should these be CHARs ?? */
  316. };
  317.  
  318. #define stringof(x)\
  319.   (&((x)->STRING.value))
  320.  
  321. struct funcallable_object_structure {
  322.   Object_t header;
  323.  
  324.   LispObject    (*cfun)();
  325.   LispObject    cfun_arg;
  326. };
  327.  
  328. struct continue_structure {
  329.   Object_t header;
  330.  
  331.   LispObject    value;     /* Returned with... */
  332.   LispObject    target;    /* When bouncing unwind protects... */
  333.  
  334.   LispObject    thread;
  335.  
  336.   LispObject  *gc_stack_pointer; /* Interpreter state */
  337.   Env           dynamic_env;
  338.   LispObject    last_continue;
  339.   LispObject    handler_stack;
  340.  
  341.   LispObject    dp;  /* Elvira state */
  342.  
  343.   /* Bytecode state? */
  344.  
  345.   jmp_buf       machine_state;
  346.  
  347.   int           live;
  348.   int           unwind;
  349.  
  350. };
  351.  
  352. struct thread_structure {
  353.   Object_t header;
  354.  
  355.   LispObject*  gc_stack_base;
  356.   
  357.  
  358.   LispObject     state;
  359.  
  360.   LispObject    fun;
  361.   LispObject    args;
  362.   LispObject    value;
  363.  
  364.   LispObject    parent;
  365.   LispObject    cochain;
  366.   int           status;
  367.   int           stack_size;
  368.   int           gc_stack_size;
  369.   int*          stack_base;
  370.  
  371. };
  372.  
  373. struct semaphore_structure {
  374.   Object_t header;
  375.   SystemSemaphore semaphore; /* Just a hacked wrapper */
  376. };
  377.  
  378. struct class_structure {
  379.   Object_t header;
  380.   int           local_count;   /* Number of local slots */
  381.  
  382.   LispObject    name;           /* Name of the class (NOT binding name) */
  383.   LispObject    superclasses;  /* Direct parents */
  384.   LispObject    subclasses;    /* Direct subclasses */
  385.   LispObject    slot_table;    /* Table of slot descriptions */
  386.   LispObject    slot_list;     /* Slot list */
  387.   LispObject    direct_slot_list; /* Direct slot list */
  388.   LispObject    precedence;    /* Class precedence list */
  389. #ifdef notdef /* Thu Oct 17 14:50:09 1991 */
  390. /**/  LispObject    prototype;     /* Prototypical instance */ *
  391. #endif /* notdef Thu Oct 17 14:50:09 1991 */
  392.  
  393. };
  394.  
  395. #define slotref(v,n)  (*(&((v)->INSTANCE.slots) + (n)))
  396. #define slotrefupdate(v,n,obj) (slotref(v,n)=obj)
  397.  
  398. struct instance_structure {
  399.   Object_t    header;
  400.   LispObject    slots;        /* Some structure of data */
  401. };
  402.  
  403.  
  404. /* Functions... */
  405.  
  406. /* Special forms are compiler only and don't have homes (?) */
  407.  
  408. struct special_structure {
  409.   Object_t header;
  410.   LispObject    name;
  411.   Env           env;
  412.   LispObject    (*func)();
  413. };
  414.  
  415. /* Basic function template to which all conform */
  416.  
  417. struct function_structure {
  418.   Object_t     header;
  419.   LispObject    name;      /* Original name in their module of origin */
  420.   LispObject    home;      /* Module of origin */
  421.   Env        env;       /* Defining parameter environment */
  422.   int        argtype;   /* Argument type code - unique for args */
  423. };
  424.  
  425. struct c_function_structure {
  426.   Object_t      header;
  427.   LispObject  name;
  428.   LispObject  home;
  429.   Env         env;
  430.  
  431.   int         argtype;
  432.   LispObject  (*func)();   /* Compiled functions just need fun pointer */
  433. };
  434.  
  435. struct i_function_structure {
  436.   Object_t    header;
  437.   LispObject    name;
  438.   LispObject    home;  
  439.   Env        env;
  440.  
  441.   int        argtype;    
  442.   LispObject    bvl;        /* Parameter list */
  443.   LispObject    body;           /* Body forms */
  444. };
  445.  
  446. /* Macros are a logical entity - being just specially interpretted functions */
  447.  
  448. struct generic_structure {   
  449.   Object_t     header;
  450.  
  451.   LispObject    name;
  452.   LispObject    home;
  453.   Env           env;           /* Redundant, I think */
  454.   int           argtype;
  455.  
  456.   LispObject    method_class;
  457.   LispObject    discriminator;
  458.   LispObject    cache_table;
  459.   LispObject    method_table;  /* Like it says */
  460. };
  461.  
  462. /* Methods AREN'T FUNCTIONS ! */
  463.  
  464. struct method_structure {
  465.   Object_t header;
  466.  
  467.   LispObject    qualifier;     /* Whatever that may be */
  468.   LispObject    signature;     /* Class list up to any n-ary bit */
  469.   LispObject    host;          /* Generic function ( nil => unatached ) */
  470.   LispObject    function;      /* The actual function */
  471.   LispObject           fixed;         /* Detatchable or not */
  472. };
  473.  
  474. /* Module structures */
  475.  
  476. /* Template for all types - an abstract class like function */
  477.  
  478. struct module_structure {
  479.   Object_t      header;
  480.   LispObject  name;              /* Symbol */
  481.   LispObject  home;              /* In ? */
  482.   LispObject  imported_modules;  /* Module dependecies - name list */
  483.   LispObject  exported_names;    /* Name list too */
  484.   LispObject  bindings;
  485. };
  486.  
  487. struct c_module_structure {
  488.   Object_t    header;
  489.   LispObject  name;
  490.   LispObject  home;
  491.   LispObject  imported_modules;
  492.   LispObject  exported_names;
  493.   LispObject  bindings;
  494.   
  495.   LispObject  values;            /* Value vector of static module */
  496.   LispObject  entry_count;
  497.   LispObject  (**functions)();   /* Function vector */
  498. };
  499.  
  500. typedef struct c_module_structure MODULE;
  501.  
  502. struct i_module_structure {
  503.   Object_t     header;
  504.   LispObject   name;
  505.   LispObject   home;
  506.   LispObject   imported_modules;      
  507.   LispObject   exported_names;        
  508.   LispObject   bindings;
  509.  
  510.   int          bounce_flag;
  511. };
  512.  
  513. /* Sockets support... */
  514.  
  515. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  516.  
  517. #include "syssockets.h"
  518.  
  519. struct listener_structure {
  520.   Object_t header;
  521.   
  522.   SocketHandle   socket;
  523.   SocketInName   name;
  524.  
  525.   int            state;
  526. };
  527.  
  528. struct socket_structure {
  529.   Object_t      header;
  530.  
  531.   SocketHandle   socket;
  532.   SocketInName   name;
  533.  
  534.   char           buffer[SOCKET_BUFFER_SIZE]; /* Input buffer */
  535.  
  536.   int            state;
  537. };
  538.  
  539. #endif
  540.  
  541. /* Structure for extensiblility without hacking... */
  542.  
  543. struct c_object_structure {
  544.   Object_t header;
  545.  
  546.   LispObject  *slots;        /* LispObject slot vector - garbage protected */
  547.   char        first_c_byte; /* Start of C-data, unprotected */
  548. };
  549.  
  550. /* Weak wrappers... */
  551.  
  552. struct weak_wrapper_structure {
  553.   Object_t header;
  554.   LispObject  object;
  555. };
  556.  
  557. union lispunion {
  558.   struct hunk_structure         HUNK;
  559.   struct object_structure    OBJECT;
  560.   struct integer_structure    INT;
  561.   struct float_structure    FLOAT;
  562.   struct bignum_structure    BIGNUM;
  563.   struct complex_structure    COMPLEX;
  564.   struct ratio_structure    RATIO;
  565.   struct character_structure    CHAR;
  566.   struct symbol_structure    SYMBOL;
  567.   struct table_structure    TABLE;
  568.   struct cons_structure        CONS;
  569.   struct stream_structure    STREAM;
  570.   struct string_structure       STRING;
  571.   struct thread_structure       THREAD;
  572.   struct semaphore_structure    SEMAPHORE;
  573.   struct class_structure    CLASS;
  574.   struct instance_structure    INSTANCE;
  575.   struct vector_structure       VECTOR;
  576.   struct continue_structure    CONTINUE;
  577.   struct envobject        ENV;
  578.   struct special_structure      SPECIAL;
  579.   struct function_structure     FUNCTION;
  580.   struct c_function_structure   C_FUNCTION;
  581.   struct i_function_structure   I_FUNCTION;
  582. /**  struct generic_structure      GENERIC; */
  583.   struct function_structure     MACRO;
  584.   struct c_function_structure   C_MACRO;
  585.   struct i_function_structure   I_MACRO;
  586. /**   struct method_structure       METHOD; */
  587.   struct module_structure       MODULE;
  588.   struct c_module_structure     C_MODULE;
  589.   struct i_module_structure     I_MODULE;
  590. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  591.   struct listener_structure     LISTENER;
  592.   struct socket_structure       SOCKET;
  593. #endif 
  594.   struct c_object_structure     C_OBJECT;
  595.   struct weak_wrapper_structure WEAK_WRAPPER;
  596. };
  597.  
  598. #include "system_p.h"
  599.  
  600. #endif /* STRUCTS_H */
  601.  
  602. /* End of structs.h */
  603.